perm filename SPOT5.SAI[11,ALS] blob
sn#073874 filedate 1973-11-23 generic text, type T, neo UTF8
00010 BEGIN "PLOT"
00020 DEFINE ⊂="COMMENT"; ⊂ NOV.18,1973;
00030 ⊂ Modified to use pulse markers and to permit their motion;
00040 DEFINE ⊃="⊂";
00050 DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00060 REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00070 LABEL STARTP,STOPP,TOFORM;
00080 ⊂ DEFINE \=" "; DEFINE \="SAFE"; ⊂ Alternarte definitions;
00090 ⊂ REQUIRE "LPC2[X,ALS]" LOAD_MODULE;
00100 FORTRAN REAL PROCEDURE SQRT(REAL X);
00110 FORTRAN REAL PROCEDURE ALOG10(REAL X);
00120 FORTRAN REAL PROCEDURE COS(REAL X);
00130 FORTRAN REAL PROCEDURE SIN(REAL X);
00140 INTEGER ZEROC,ZEROF,DX;
00150 ⊂ EXTERNAL FORTRAN PROCEDURE LPC1(REFERENCE REAL A,B,R0,C;⊂ REFERENCE INTEGER N,I,J);
00160 REQUIRE "F[X,ALS]" LOAD_MODULE;
00170 EXTERNAL FORTRAN PROCEDURE FRXFM
00180 (REFERENCE INTEGER M;REFERENCE REAL X,Y);
00190 \ INTERNAL REAL ARRAY A,B,C,D[0:512];
00200 REAL X,SX; \ REAL ARRAY WINDOW[0:512];
00210 INTERNAL REAL R0;
00220 INTEGER LPCOPT;
00230 \ INTEGER ARRAY DPYBUF[0:1535];
00240 \ INTEGER ARRAY LFILE[0:'177];
00250 \ INTEGER ARRAY SYMBOL[0:127];
00260 \ INTEGER ARRAY DAT,AVDAT[0:23];
00270 \ INTEGER ARRAY FVAL[0:8];
00280 INTEGER FX,SEGCS;
00290 STRING ARRAY SAMPLE[0:127];
00300 INTEGER I,J,K,L,P,PP,Q,QQ,R,DK,DDK,DDDK,DVAL,DDVAL,DDDVAL,
00310 POINTX,STATE,DELTA,VAL,CHAN1,EOF,POINTT,POINTV;
00320 INTERNAL INTEGER M,N;
00330 INTEGER PT0,PT1,PT2,X0,X1,Y0,Y1,X2,Y2,
00340 PTCNT,PICK,JP,JPX,OPT,OPT1,SHUFCT;
00350 INTEGER II,JJ,KK,NN,SEGC,BRK,EOFA,EOFT,EOFTF,READ3,
00360 SEGTOT,SEGIN,IIT,JJT,KKT,NNT,ITT,JTT,KTT,SEGCT;
00370 BOOLEAN ER;
00380 INTEGER CHAN2,CHAN3,CHAN4,CHAN5,CHAN6,CHANX;
00390 \ INTEGER ARRAY BUF,BUFT,BUFTT[0:511];
00400 STRING FILEN,READ,READ1,READT,READTT,FILEO,READ2,FILEQ,TFILE,FILLST;
00410
00420 PROCEDURE OUTALL(STRING S);
00430 BEGIN
00440 STRING SS; INTEGER J;
00450 SETBREAK(18,0,NULL,"OSN");
00460 SS←SCAN(S,18,J);
00470 OUTSTR(SS);
00480 END;
00490
00500 PROCEDURE DATAIN;
00510 BEGIN
00520 INTEGER J;
00530 FOR J←0 STEP 1 UNTIL 511 DO BUF[J]←0;
00540 IF EOF=0 THEN ARRYIN(CHAN1,BUF[0],512)
00550 ELSE OUTSTR
00560 ("No more data with JJ= "&CVS(JJ)&"SEGC= "&CVS(SEGC)&CRLF);
00570 POINTX←POINT(12,BUF[0],-1);
00580 SEGC←II←II+12; JJ←II+11;
00590 END;
00600
00610 PROCEDURE DATTIN;
00620 BEGIN
00630 INTEGER J;
00640 FOR J←0 STEP 1 UNTIL 511 DO BUFT[J]←0;
00650 IF EOFA=0 THEN ARRYIN(CHAN2,BUFT[0],512)
00660 ELSE OUTSTR
00670 ("No more T0X data with JJ= "&CVS(JJ)&"SEGC= "&CVS(SEGC)&CRLF);
00680 POINTT←POINT(6,BUFT[0],-1);
00690 SEGCT←IIT←IIT+128; JJT←IIT+127;
00700 END;
00710
00720 PROCEDURE DTTTIN;
00730 BEGIN
00740 INTEGER J;
00750 IF EOFT=0 THEN ARRYIN(CHAN3,BUFTT[0],512)
00760 ELSE OUTSTR
00770 ("No more .P data with JJ= "&CVS(JJ)&"SEGC= "&CVS(SEGC)&CRLF);
00780 FOR J←0 STEP 1 UNTIL 511 DO IF BUFTT[J]=0 THEN BUFTT[J]←'377777777777;
00790 ITT←BUFTT[0] LSH -15; KTT←0; JTT←BUFTT[511] LSH -15;
00800 ⊂ FOR J←0 STEP 1 UNTIL 10 DO OUTSTR(CVOS(BUFTT[J])&TB);
00810 END;
00820
00830 PROCEDURE PLOTP;
00840 BEGIN
00850 INTEGER J,K,L,DJ;
00860 K←0; RIVECT(0,-100);
00870 WHILE TRUE DO BEGIN "PIN"
00880 J←(BUFTT[KTT] LSH -15)-((SEGC-1)*128);
00890 ⊂ OUTSTR("KTT="&CVS(KTT)&TB&TB&CVS(J)&TB&CVS(SEGC)&CRLF);
00900 IF J<0 THEN
00910 IF KTT<511 THEN BEGIN KTT←KTT+1; CONTINUE "PIN"; END ELSE BEGIN
00920 IF EOFTF≠0 THEN DONE "PIN"; DTTTIN; CONTINUE "PIN"; END;
00930 IF J>128 THEN DONE "PIN" ELSE BEGIN
00940 ⊂ OUTSTR("A pulse mark has been written at J="&CVS(J)&CRLF);
00950 ⊂ OUTSTR("KTT="&CVS(KTT)&TB&TB&CVS(J)&TB&CVS(SEGC)&CRLF);
00960 DJ←J-K; K←J; KTT←KTT+1;
00970 FVAL[FX]←(SEGC-SEGCS)*128+K;
00980 OUTSTR(CVS(FVAL[FX])&CRLF);
00990 FX←FX+1;
01000 RIVECT(DJ,0); RVECT(0,30); RVECT(0,-30); END;
01010 END "PIN";
01020 RIVECT(-K,100);
01030 END;
01040
01050
01060 PROCEDURE PLOT;
01070 BEGIN
01080 INTEGER I,JP,K,LP;
01090 PTCNT←PTCNT+1; IF PTCNT≤4 THEN BEGIN
01100 PLOTP;
01110 POINTV←POINTX;
01120 K←LDB(POINTV); IF K>2047 THEN K←K-4096;
01130 K←K%8;
01140
01150 RIVECT(0,K);
01160 FOR I←0 STEP 1 UNTIL 127 DO BEGIN
01170 JP←ILDB(POINTV); IF JP>2047 THEN JP←JP-4096;
01180 D[DX]←JP; DX←DX+1;
01190 ⊃ SETFORMAT(10,3); ⊃ OUTSTR(CVS(I)&TB&CVG(JP)&CRLF);
01200 JP←JP%8;
01210 LP←JP-K; RVECT(1,LP); K←JP; END;
01220 RIVECT(0,-K);
01230 IF PTCNT=4 THEN BEGIN
01240 RIVECT(-200,-130);
01250 IF (SYMBOL[Q] LAND '3777777777)>0 THEN READ←CVSTR(SYMBOL[Q])[1 TO 2] ELSE
01260 READ←CVSTR(SYMBOL[Q])[1 TO 1];
01270 IF OPT1=1 THEN BEGIN
01280 DPYSST(CVXSTR(LFILE[10])[2 TO 3]&" "&READ&" ? "&CVS(JPX));
01290 SETFORMAT(1,0);
01300 IF (J-JPX)<0 THEN DPYSST(CVS(J-JPX)) ELSE DPYSST("+"&CVS(J-JPX));
01310 SETFORMAT(3,0); END;
01320 IF OPT1≠1 THEN
01330 DPYSST(CVXSTR(LFILE[10])[2 TO 3]&" "&READ&" "&CVS(J)&" "&CVS(KK));
01340 RIVECT(60,130); END;
01350 END;END;
01360
01370 PROCEDURE FRIC;
01380 BEGIN
01390 INTEGER JJJ;
01400 ⊂ STATE=0 means on way up
01410 STATE=1 means on way down;
01420 M←0;
01430 PLOT;
01440 FOR JJJ←0 STEP 1 UNTIL 127 DO BEGIN
01450 VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
01460 DVAL←VAL-K; DDVAL←DVAL-DK; DDDVAL←DDVAL-DDK;
01470 IF STATE=0 THEN BEGIN
01480 IF DDDVAL<DDDK-DELTA THEN BEGIN
01490 M←M+(DDDK-DDDVAL); STATE←-1; END; END ELSE
01500 IF DDDVAL>DDDK+DELTA THEN BEGIN
01510 M←M+(DDDVAL-DDDK); STATE←0; END;
01520 K←VAL; DK←DVAL;DDK←DDVAL; DDDK←DDDVAL;
01530 IF JJJ=2 THEN M←0;
01540 END;
01550 M←M%400; IF M>63 THEN M←63;
01560 SEGC←SEGC+1;
01570 END;
01580
01590 PROCEDURE DATA;
01600 BEGIN
01610 INTEGER I;
01620 FOR I←0 STEP 1 UNTIL 23 DO BEGIN
01630 DAT[I]←ILDB(POINTT);
01640 AVDAT[I]←AVDAT[I]+DAT[I];
01650 END;
01660 SEGCT←SEGCT+1;
01670 END;
01680
01690 PROCEDURE TYDATT;
01700 BEGIN
01710 INTEGER I,J,K;
01720 K←0;
01730 FOR I←0 STEP 1 UNTIL 23 DO BEGIN
01740 J←ILDB(POINTT);
01750 OUTALL(CVS(J));
01760 END; OUTSTR(CRLF); END;
01770
01780 PROCEDURE SKIP;
01790 BEGIN
01800 INTEGER JJJ;
01810 FOR JJJ←0 STEP 1 UNTIL 127 DO IBP(POINTX);
01820 K←LDB(POINTX); IF K>2047 THEN K←K-4096;
01830 SEGC←SEGC+1;
01840 ⊃ OUTSTR("Skip to segc= "&CVS(SEGC)&CRLF);
01850 END;
01860
01870 PROCEDURE SKIPT;
01880 BEGIN
01890 INTEGER JJJ;
01900 FOR JJJ←0 STEP 1 UNTIL 23 DO IBP(POINTT);
01910 SEGCT←SEGCT+1;
01920 ⊃ OUTSTR("Skip to segct= "&CVS(SEGCT)&CRLF);
01930 END;
01940
01950 PROCEDURE SHUFFLE;
01960 BEGIN "SHUF"
01970 INTEGER I,J,K;
01980
01990 AIVECT(-640,-360);
02000 I←DPYPTR-PT1; ⊂ Words to save;
02010 J←PT1-PT0; ⊂ Words to overwrite;
02020 FOR K←1 STEP 1 UNTIL I DO DPYBUF[K+3]←DPYBUF[K+3+J];
02030 FOR K←I+1 STEP 1 UNTIL J+I DO DPYBUF[K+3]←1;
02040 PT1←DPYPTR←PT0+I;
02050 DPYOUT(0); PTOCHW(0,'10120);
02060 END "SHUF";
02070
02080 PROCEDURE RARDIS;
02090 BEGIN
02100 INTEGER I,J,K,SP;
02110 INTEGER LY,DY;
02120 REAL MAX,MIN;
02130
02140
02150 MAX←-1000.;MIN←10000.;
02160 FOR I←0 STEP 1 UNTIL N%2 DO IF C[I]>MAX THEN MAX←C[I];
02170 SP←6; COMMENT HORIZONTAL SPACING;
02180 FOR I←0 STEP 1 UNTIL N%2-1 DO BEGIN
02190 C[I]←5.5*(C[I]+48-MAX); IF C[I]<0 THEN C[I]←0; END;
02200 IF SHUFCT=1 THEN SHUFFLE; SHUFCT←1;
02210
02220
02230 RIVECT(60,130);
02240
02250 SETFORMAT(1,0);
02260 ⊂ Write horizantal numbers;
02270 FOR I←0 STEP 1 UNTIL 5 DO BEGIN
02280 DPYSST(CVS(I)); RIVECT(139,0); END; RIVECT(-139,0);
02290 FOR I←6 STEP 1 UNTIL 10 DO BEGIN
02300 RIVECT(36,0); DPYSST(CVS(I)); END; RIVECT(-22,-5);
02310 RIVECT(-512,0); RIVECT(-512,0);
02320
02330 rivect(-1,0); ⊂ Start with 1 off so total will be correct;
02340 ⊂ Draw scale to 5000, with 50 markers to 770;
02350 FOR I←1 STEP 1 UNTIL 5 DO BEGIN
02360 FOR J←1 STEP 1 UNTIL 2 DO BEGIN
02370 FOR K←1 STEP 1 UNTIL 2 DO BEGIN
02380 RVECT(15,0); RIVECT(0,-10); RVECT(0,10);
02390 RVECT(16,0); RIVECT(0,-10); RVECT(0,10); END;
02400 RVECT(15,0); RIVECT(0,-50); RVECT(0,50); END;
02410 RIVECT(0,-264); RVECT(0,264); END;
02420
02430 ⊂ Draw scale from 5000 to 10,000, with 25 markers to 255;
02440 FOR I←1 STEP 1 UNTIL 5 DO BEGIN
02450 FOR J←1 STEP 1 UNTIL 4 DO BEGIN
02460 RVECT(10,0); RIVECT(0,-10); RVECT(0,10); END;
02470 RVECT(11,0); RIVECT(0,-264); RVECT(0,264); END;
02480 RIVECT(-512,0); RIVECT(-512,0);
02490
02500 SETFORMAT(2,0);
02510 ⊂ Vertical numbers and vertical scale;
02520 FOR I←0 STEP 12 UNTIL 42 DO BEGIN
02530 RIVECT(-35,-7); DPYSST(CVS(I)); RIVECT(15,7);
02540 RVECT(-10,0); RVECT(0,-33);
02550 RIVECT(-35,-7); DPYSST(CVS(I+6)); RIVECT(10,7);
02560 RVECT(-5,0);RVECT(0,-33); END;
02570 RIVECT(-35,-7); DPYSST(CVS(I)); RIVECT(5,7);
02580 RVECT(512,0); RVECT(512,0); RIVECT(-512,0); RIVECT(-512,0);
02590
02600 LY←C[0]; RIVECT(0,LY);
02610 FOR I←1 STEP 1 UNTIL 128 DO
02620 BEGIN
02630 DY←C[I]-LY;
02640 LY←LY+DY;
02650 RVECT(SP,DY);
02660 END;
02670 SP←2;
02680 FOR I←129 STEP 1 UNTIL 256 DO
02690 BEGIN
02700 DY←C[I]-LY;
02710 LY←LY+DY;
02720 RVECT(SP,DY);
02730 END;
02740 RIVECT(0,108-LY);
02750 END "RARDIS";
02760
02770 INTERNAL PROCEDURE XRTRAN(REAL ARRAY A,B;INTEGER N,EVALUATE);
02780 BEGIN
02790 COMMENT IF EVALUATE IS FALSE THIS INTERNAL PROCEDURE UNSCRAMBLES THE SINGLE VARIATE
02800 COMPLEX TRANSFORM ;
02810 INTEGER K,NK,NH;
02820 REAL AA,AB,BA,BB,RE,IM,CK,SK,DC,DS,R;
02830 NH←N%2; R←3.1415926536/N;
02840 DS←SIN(R); R←-(2*SIN(0.5*R))↑2;
02850 DC←-0.5*R; CK←1.0; SK←0;
02860 IF EVALUATE THEN
02870 BEGIN
02880 CK←-1.0; DC←-DC;
02890 END
02900 ELSE
02910 BEGIN
02920 A[N]←A[0]; B[N]←B[0];
02930 END;
02940 FOR K←0 STEP 1 UNTIL NH DO
02950 BEGIN
02960 NK←N-K;
02970 AA←A[K]+A[NK]; AB←A[K]-A[NK];
02980 BA←B[K]+B[NK]; BB←B[K]-B[NK];
02990 RE←CK*BA+SK*AB; IM←SK*BA-CK*AB;
03000 B[NK]←IM-BB; B[K]←IM+BB;
03010 A[NK]←AA-RE; A[K]←AA+RE;
03020 DC←R*CK+DC; CK←CK+DC;
03030 DS←R*SK+DS; SK←SK+DS;
03040 END;
03050 END "XRTRAN";
03060
03070 INTERNAL PROCEDURE FORM(INTEGER LPCOPT);
03080 BEGIN "FORM"
03090 REAL ERRN,ERR;
03100 INTEGER I,J;
03110 M←9; N←2↑M; DEFINE PI="3.141592653";
03120 IF FX=0 THEN
03130 FOR I←0 STEP 1 UNTIL N DO WINDOW[I]←(1-COS((2*PI*I)/N))/2
03140
03150 ELSE BEGIN N←FVAL[FX+1]-FVAL[FX]; J←0;
03160 FOR I←0 STEP 1 UNTIL FVAL[FX] DO WINDOW[I]←0;
03170 FOR I←FVAL[FX] STEP 1 UNTIL FVAL[FX+1] DO BEGIN
03180 WINDOW[I]←(1-COS((2*PI*J)/N))/2; J←J+1; END;
03190 FOR I←FVAL[FX+1] STEP 1 UNTIL 512 DO WINDOW[I]←0; END;
03200 FOR I←0 STEP 1 UNTIL 512 DO A[I]←D[I];
03210
03220 IF LPCOPT=0 THEN BEGIN "LPC"
03230 FOR I←0 STEP 1 UNTIL N-2 DO A[I]←(A[I+1]-A[I])*WINDOW[I];
03240 ⊂ LOADS DATA IN A, DIFFERENTIATES AND WINDOWS ;
03250 I←24; J←N%2;
03260 ⊂ LPC1(A[0],B[0],R0,C[0],N,I,J);
03270 END "LPC" ELSE
03280
03290 BEGIN "FFT"
03300 FOR I←0 STEP 1 UNTIL 512 DO BEGIN
03310 A[I]←D[I]*WINDOW[I]; B[I]←0;
03320 ⊃ SETFORMAT(10,3); ⊃ OUTSTR(CVS(I)&TB&CVG(D[I])&TB&CVG(A[I])&CRLF);
03330 END;
03340 FRXFM(M,A[0],B[0]);
03350 ⊃ OUTSTR("FFT COMPLETE"&CRLF);
03360 FOR I←0 STEP 1 UNTIL 256 DO BEGIN
03370 X←A[I]↑2+B[I]↑2+1.*10↑-37;
03380 ⊃ OUTSTR(CVG(A[I])&" "&CVG(B[I])&" "&CVG(X)&TB);
03390 C[I]←10.*ALOG10(X); END;
03400 END "FFT";
03410
03420 RARDIS;
03430 END "FORM";
03440
03450 PROCEDURE MARK;
03460 BEGIN
03470 INTEGER I,J,K,L,JP,LP,PT2;
03480
03490 PTOCHW(0,'14127); ⊂ Makes the WHQ line go away;
03500 IF SHUFCT=1 THEN BEGIN SHUFCT←0; SHUFFLE; END;
03510 TYPLOC(512,430); AIVECT(-630,270);
03520 RIVECT(0,-130); SETFORMAT(3,0);
03530 FOR I←0 STEP 20 UNTIL 380 DO BEGIN
03540 DPYSST(CVS(I)); RIVECT(15,0); END;
03550 RIVECT(-985,130); RIVECT(-200,0);
03560
03570 FOR I←0 STEP 100 UNTIL 300 DO BEGIN "HUNDRED"
03580 RVECT(0,-30); RIVECT(0,-40); RVECT(0,-30);
03590 FOR J←0 STEP 50 UNTIL 50 DO BEGIN "FIFTY"
03600 L←I+J;
03610 FOR K←1 STEP 1 UNTIL 5 DO BEGIN "TEN"
03620 RIVECT(15,0); RVECT(0,5); RIVECT(0,90); RVECT(0,5);
03630 RIVECT(15,0); RVECT(0,-10);RIVECT(0,-80);RVECT(0,-10);
03640 IF L+K=353 THEN DONE "HUNDRED";
03650 END "TEN";
03660 RVECT(0,20); RIVECT(0,60); RVECT(0,20); RIVECT(0,-100);
03670 END "FIFTY";
03680 RIVECT(0,100);
03690 END "HUNDRED";
03700 RIVECT(-940,100); RIVECT(-200,0);
03710
03720 K←D[0]%8; RIVECT(0,K);
03730 FOR I←1 STEP 1 UNTIL 384 DO BEGIN
03740 JP←D[I]%8;
03750 LP←JP-K; RVECT(3,LP); K←JP; END;
03760 RIVECT(-952,-K); RIVECT(-200,0);
03770
03780 PT2←DPYPTR; READ1←"NO"; CLRBUF;
03790
03800 FOR I←1 STEP 1 UNTIL 2 DO BEGIN
03810 WHILE TRUE DO BEGIN
03820 IF READ1≠"" THEN BEGIN DPYPTR←PT2;
03830 RIVECT(570,0);
03840 FOR J←1 STEP 1 UNTIL 2 DO BEGIN
03850 L←3*FVAL[J]-570;
03860 RIVECT(L,100); RVECT(0,-100); RIVECT(-15,0); RVECT(30,0);
03870 RIVECT(-15,0); RVECT(0,-100); RIVECT(-L,100); END;
03880 RIVECT(-570,0);
03890 DPYOUT(0); END;
03900 IF FVAL[I]=0 THEN OUTSTR("Specify position of marker #"&
03910 CVS(I)&" ") ELSE OUTSTR("Move marker #"&CVS(I)&" (CR if OK) ");
03920 IF (READ1←INCHWL)="" THEN DONE;
03930 FVAL[I]←FVAL[I]+CVD(READ1);
03940 END; END;
03950
03960 AIVECT(-640,-360); PT1←DPYPTR; FX←1; FORM(1);
03970 END;
03980
04000 INTERNAL PROCEDURE CALCOMP(STRING FILE;INTEGER ARRAY BUFR);
04010 ⊃ Outputs display buffer BUFR to disk file FILE in a format
04020 readable by the Nealy Calcomp plotter program PLTVEC, and by
04030 the Quam Video Synthesizer program MIRTOP;
04040 IF FILE THEN
04050 BEGIN INTEGER DSIZ,CCCHN;
04060 OPEN(CCCHN←GETCHAN,"DSK",'14,0,1,0,0,0);
04070 ENTER(CCCHN,FILE&".GRF",0);
04075 OUTSTR("READY TO DPYPARS");
04080 DPYPARS;DSIZ←BUFR[1]+4;
04085 OUTSTR("BACK FROM DPYPARS"&CRLF);
04090 ARRYOUT(CCCHN,BUFR[0],2);WORDOUT(CCCHN,0);
04100 ARRYOUT(CCCHN,BUFR[2],DSIZ-2);
04110 RELEASE(CCCHN);
04120 END "CALCOMP";
00010 DPYSET(DPYBUF); AIVECT(-640,-70); PT0←DPYPTR;
00020 SHUFCT←0;AIVECT(-640,-360);PT1←DPYPTR;
00030 FILEN←"HI20.001[CMP,JH]";
00040 FILEO←"SEG1.FRI";
00050 ⊂ HEADIN;
00060 STDBRK(1);
00070 SETBREAK(14,"∃",NULL,"INS");
00080 SETBREAK(15,'11&'12&'14&'15&'40,NULL,"INS");
00090 SETBREAK(16,'56,NULL,"INA");
00100 SETBREAK(17,'12,'15,"INS");
00110
00120 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4; CHAN5←5; CHAN6←6;
00130 OUTSTR("This program shows header information and wave forms for selected "
00140 &" phones."&crlf&LF);
00150 OUTSTR("At present this program takes acoustic data from [CMP,JH],"&
00160 CRLF&tb&"indentifying information from MAP.PHM[11,ALS]"&CRLF&
00170 TB&"pulse informstion from .P[PIT,NJM] files"&CRLF&TB&
00180 "and header information from files .T0X[11,ALS]."&CRLF&LF);
00190 OUTSTR("After a display it accepts the following commands"&CRLF&TB&
00200 "Space bar - go to the next phone"&CRLF&TB&
00210 "S - start over"&CRLF&TB&
00220 "E - exit from program"&CRLF&TB&
00230 "a number - shift by specified # of 6.4 ms intervals"&CRLF&TB&
00240 "line feed - next phone from a forward shifted location"&CRLF&TB&
00250 "F &CR - 512 point FFT"&CRLF&TB&
00260 "F & # - interval FFT starting st marker number #"&CRLF&TB&
00270 "M - go to movable marker mode"&crlf&TB&
00280 "W - write DPYBUF to clear plot"&CRLF&LF);
00290
00300 CLOSE(CHAN4); OPEN(CHAN4,"DSK",1,2,0,3500,BRK,EOFA);
00310 LOOKUP(CHAN4,"MAP.PHN[11,ALS]",ER);
00320 WHILE ER DO BEGIN OUTSTR(CRLF&"Can't find MAP.PHN[11,ALS]. File = ");
00330 LOOKUP(CHAN4,TFILE←INCHWL,ER); END; EOFA←0;
00340 FILLST←INPUT(CHAN4,14);
00350 CLOSE(CHAN4);
00360
00370 FOR I←0 STEP 1 UNTIL 127 DO BEGIN
00380 WHILE TRUE DO BEGIN
00390 READ1←SCAN(FILLST,17,K);
00400 READ3←READ1[1 TO 1];
00410 IF READ3≠"⊂" THEN DONE; END;
00420 IF READ3="" THEN DONE;
00430 SYMBOL[I]←CVASC(SCAN(READ1,15,K));
00440 SAMPLE[I]←READ1; END;
00450
00460 STARTP:
00470 WHILE TRUE DO BEGIN "PICK"
00480 OUTSTR("Select PH (CR only for everything) ");
00490 IF (READ←INCHWL)="" THEN DONE ELSE BEGIN PICK←CVASC(READ);
00500 FOR Q←0 STEP 1 UNTIL 127 DO IF PICK=SYMBOL[Q] THEN DONE;
00510 IF Q<128 THEN DONE;
00520 OUTSTR("Not found"&crlf); END; END "PICK";
00530
00540 OUTSTR(CRLF&"You have selected "&tb);
00550 IF READ="" THEN BEGIN OPT←0; OUTSTR("Everything"&crlf); END ELSE BEGIN
00560 OUTALL(CVSTR(PICK)&TB&SAMPLE[Q]&CRLF&" "); OPT←1; END;
00570 DELTA←15;
00580 ⊂ OUTSTR("Specify DELTA (CR for 15) ");
00590 ⊂ IF (READ←INCHWL)="" THEN DELTA←15 ELSE DELTA←CVD(READ);
00600
00610 OUTSTR(CRLF&"Type number of file to start (CR only for 1) ");
00620 IF (READ←INCHWL)="" THEN PP←1 ELSE PP←CVD(READ);
00630 TYPLOC(512,100);
00640 FOR PP←PP STEP 1 UNTIL 26 DO BEGIN "FILEREAD"
00650 CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00660 SETFORMAT(-3,0); FILEQ←CVS(PP);
00670 FILEN←FILEN[1 TO 5]&FILEQ&"[CMP,JH]";
00680 LOOKUP(CHAN1,FILEN,ER); TFILE←FILEN;
00690 WHILE ER DO BEGIN
00700 IF PP>1 THEN BEGIN OUTSTR("Out of data, will start over."&CRLF);
00710 GOTO STARTP; END;
00720 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
00730 LOOKUP(CHAN1,TFILE←INCHWL,ER); END;
00740 J←K←L←STATE←VAL←R←0;
00750 SETFORMAT(1,0); FILEQ←CVS(PP);
00760
00770 READT←FILEO[1 TO 3]&FILEQ&".T0X[11,ALS]";
00780 CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,10,0,0,0,EOFA);
00790 LOOKUP(CHAN2,READT,ER); TFILE←READT;
00800 WHILE ER DO BEGIN
00810 IF PP>1 THEN BEGIN OUTSTR("Out of data, will start over."&CRLF);
00820 GOTO STARTP; END;
00830 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
00840 LOOKUP(CHAN2,TFILE←INCHWL,ER); END;
00850 ARRYIN(CHAN2,LFILE[0],'200); ⊂ Input header;
00860 SEGTOT←(LFILE[0]*6)%256;
00870 ⊃ OUTSTR(FILEI&" "&CVS(SEGTOT)&" ");
00880
00890 READ2←READT;
00900 READTT←SCAN(READ2,16,J)&"P[PIT,NJM]";
00910 ⊂ OUTSTR(READTT&CRLF);
00920 CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,10,0,0,0,EOFT);
00930 LOOKUP(CHAN3,READTT,ER); TFILE←READTT;
00940 ITT←JTT←-1000;KTT←0;
00950 IF ER THEN BEGIN
00960 OUTSTR("No .P data (S to start over, space bar to ignore) ");
00970 IF (READ1←INCHRW)="S" THEN GOTO STARTP ELSE BEGIN
00980 BUFTT[0]←'77777; BUFTT[1]←'377777700000;ITT←0; JTT←'3777777;
00990 CLRBUF; END; END;
01000
01010 II←-11; JJ←-1; IIT←-127; JJT←-1; SETFORMAT(3,0); SEGIN←0;
01020
01030 ⊂ Begin "SELECT";
01040
01050 FOR I←21 STEP 1 UNTIL 127 DO BEGIN "SELECT"
01060 IF LFILE[I]=0 THEN IF I>0 THEN DONE ELSE BEGIN
01070 OUTSTR("No data."&crlf); done end;
01080 L←LFILE[I] LAND '777760000000;
01090
01100 ⊂ Begin "FOUND";
01110
01120 IF (OPT=0) ∨ (L=PICK) THEN BEGIN "FOUND"
01130 FOR Q←0 STEP 1 UNTIL 126 DO IF L=SYMBOL[Q] THEN DONE;
01140 JPX←J←LDB(POINT(14,LFILE[I],27)); KK←LDB(POINT(8,LFILE[I],35));
01150
01160 ⊂ Begin "GET";
01170
01180 WHILE TRUE DO BEGIN "GET"
01190
01200 SEGCS←J; FX←1;
01210 IF KK<4 THEN PTCNT←4-KK ELSE PTCNT←0;
01220
01230 IF II>J THEN BEGIN
01240 IF (READ1='12) THEN CONTINUE "SELECT";
01250 CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
01260 LOOKUP(CHAN1,FILEN,ER); TFILE←FILEN;
01270 WHILE ER DO BEGIN
01280 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
01290 LOOKUP(CHAN1,TFILE←INCHWL,ER); END;
01300 II←-11; JJ←-1;
01310 END;
01320
01330 IF IIT>J THEN BEGIN
01340 IF (READ1='12) THEN CONTINUE "SELECT";
01350 CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,10,0,0,0,EOFA);
01360 LOOKUP(CHAN2,READT,ER); TFILE←READT;
01370 WHILE ER DO BEGIN
01380 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
01390 LOOKUP(CHAN2,TFILE←INCHWL,ER); END;
01400 ARRYIN(CHAN2,LFILE[0],'200); ⊂ Input header;
01410 IIT←-127; JJT←-1;
01420 END;
01430
01440 ⊂ OUTSTR("ITT="&CVS(ITT)&TB&"J="&CVS(J)&CRLF);
01450 IF ITT>J*128 THEN BEGIN
01460 IF (READ1='12) THEN CONTINUE "SELECT";
01470 CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,10,0,0,0,EOFT);
01480 LOOKUP(CHAN3,READTT,ER); TFILE←READTT;
01490 WHILE ER DO BEGIN
01500 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
01510 LOOKUP(CHAN3,TFILE←INCHWL,ER); END;
01520 ITT←JTT←-1000; KTT←0;
01530 END;
01540
01550 ⊂ OUTSTR("JTT="&CVS(JTT)&TB&"J="&CVS(J)&CRLF);
01560 WHILE JJ<J DO DATAIN; WHILE JJT<J DO DATTIN;
01570 ⊂ OUTSTR("JJ="&CVS(JTT)&TB&"J="&CVS(J)&"before DTTTIN");
01580 WHILE JTT<(J-1)*128 DO DTTTIN;
01590 ⊂ OUTSTR(" and after JTT="&CVS(JTT)&CRLF);
01600
01610
01620 IF SEGC>J THEN BEGIN
01630 POINTX←POINT(12,BUF[0],-1);
01640 SEGC←II; JJ←II+11; END;
01650
01660 IF SEGCT>J THEN BEGIN
01670 POINTT←POINT(6,BUFT[0],-1);
01680 SEGCT←IIT; JJT←IIT+127; END;
01690
01700 ⊂ OUTSTR("KTT="&CVS(KTT)&TB&"BUFTT[KTT] LSH -15="&CVS(BUFTT[KTT] LSH -15)&TB&"J="&CVS(J)&CRLF);
01710 WHILE (BUFTT[KTT] LSH -15)>(J-1)*128 DO BEGIN
01720 IF KTT=0 THEN DONE; KTT←KTT-1; END;
01730
01740 WHILE SEGC<J DO SKIP; WHILE SEGCT<J DO SKIPT;
01750
01760 IF SHUFCT=0 THEN BEGIN
01770 OUTSTR(
01780 " F1 F3 A2 FP1 FP2 FZ NP NZ LPE HPE HPA PIT"
01790 &CRLF&
01800 " F2 A1 A3 FP1A FP2A FZA NPA NZA AVE LPA FRI FRI4"
01810 &CRLF); END;
01820
01830 FOR QQ←0 STEP 1 UNTIL 7 DO FVAL[QQ]←0;
01840 FOR DX←0 STEP 1 UNTIL 512 DO D[DX]←0; DX←0;
01850 IF OPT1=1 THEN FOR QQ←1 STEP 1 UNTIL 4 DO BEGIN
01860 IF SEGC>JJ THEN DATAIN; IF SEGCT>JJT THEN DATTIN;
01870 FRIC;
01880 DATA; DAT[23]←M;
01890 OUTSTR(CVS(QQ)&" ");
01900 FOR K←0 STEP 1 UNTIL 23 DO OUTSTR(CVS(DAT[K])); OUTSTR(CRLF);
01910 END ELSE BEGIN
01920 FRIC;
01930 FOR K←0 STEP 1 UNTIL 23 DO AVDAT[K]←0;
01940 DATA; DAT[23]←M;
01950
01960 OUTSTR(" F ");
01970 FOR K←0 STEP 1 UNTIL 23 DO OUTSTR(CVS(DAT[K])); OUTSTR(CRLF);
01980 N←M;
01990
02000 FOR R←2 STEP 1 UNTIL KK DO BEGIN
02010 IF SEGC>JJ THEN DATAIN;
02020 IF SEGCT>JJT THEN DATTIN;
02030 FRIC; N←N+M; DATA; END;
02040 DAT[23]←M; AVDAT[23]←N;
02050 OUTSTR(" A ");
02060 FOR K←0 STEP 1 UNTIL 23 DO BEGIN
02070 AVDAT[K]←AVDAT[K]%KK; OUTSTR(CVS(AVDAT[K])); END; OUTSTR(CRLF);
02080 OUTSTR(" L ");
02090 FOR K←0 STEP 1 UNTIL 23 DO OUTSTR(CVS(DAT[K])); OUTSTR(CRLF);
02100 END;
02110
02120 OUTSTR("space to cont., F for FFT, M for mode, "&
02130 "# to shift, S to start, W to write."&crlf);
02140
02150
02160 ⊂ Begin "SHOW";
02170
02180 WHILE TRUE DO BEGIN "SHOW"
02190 DPYOUT(0);PTOCHW(0,'10120); PTCNT←0;
02200
02210 FOR QQ←4 STEP 1 UNTIL 4095 DO IF DPYBUF[QQ] =1 THEN DONE;
02220 OUTSTR("DPYBUF filled to "&CVS(QQ)&CRLF);
02230
02240 READ1←INCHRW;
02250 WHILE (READ1="W")∨(READ1="w") DO BEGIN DPYOUT(0) ;READ1←"NO";
02260 PTOCHW(0,'10120);INCHRW; END;
02265 IF (READ1="P")∨(READ1="p") THEN BEGIN CALCOMP("PLOTX",DPYBUF);
02267 OUTSTR("RU DPYXGP[1,PDQ] with file PLOTX.GRF to get xgp listing"&CRLF);
02268 END;
02270 IF (READ1≠"M")∧(READ1≠"F")∧(READ1≠"m")∧(READ1≠"f") THEN BEGIN
02280 TYPLOC(512,100); PTOCHW(0,'10103); PTOCHW(0,'10120); END;
02290 SHUFCT←SHUFCT+1; IF SHUFCT<2 THEN RIVECT(40,0)
02300 ELSE BEGIN SHUFCT←0; SHUFFLE; END;
02310 K←CVASC(READ1); OPT1←0;
02320
02330 IF K≥CVASC("+") THEN IF K≤CVASC("9") THEN BEGIN
02340 JP←CVD(READ1&INCHWL); OPT1←1; KK←4; IF JP<(-J) THEN JP←(-J);
02350 JP↔J; J←J+JP; CONTINUE "GET"; END;
02360 OUTSTR(CR);
02370 IF READ1=" " THEN CONTINUE "SELECT";
02380 IF (READ1='15)∨(READ1='12) THEN BEGIN
02390 CLRBUF; CONTINUE "SELECT"; END;
02400 TOFORM:
02410 IF (READ1="F")∨(READ1="f") THEN BEGIN
02420 IF (READ1←INCHWL)="" THEN FX←0 ELSE FX←CVD(READ1);
02430 FORM(1); CLRBUF; END;
02440 IF (READ1="L")∨(READ1="l") THEN BEGIN FORM(0); CLRBUF; END;
02450 IF (READ1="M")∨(READ1="m") THEN MARK;
02460 IF (READ1="S")∨(READ1="s") THEN BEGIN
02470 OUTSTR(LF&"You are starting over"&CRLF); CLRBUF;
02480 GOTO STARTP; END;
02490 IF (READ1="E")∨(READ1="e") THEN GOTO STOPP;
02500 END "SHOW";
02510 END "GET";
02520 END "FOUND";
02530 END "SELECT";
02540 END "FILEREAD";
02550
02560 OUTSTR("Data are exhausted"&CRLF&LF); GOTO STARTP;
02570 STOPP: PTOCHW(0,'10103); PTOCHW(0,'10120);
02580
02590 END "PLOT";
04175